0.1 Introduction

In this Rmarkdown we are going to plot panels D, G & H. In this script we will use the the scRNAseq data from sc_analysis/04-annotation/07-join_annotation.Rmd.

0.2 Libraries

library(Seurat)
library(ggpubr)
library(cowplot)
library(dplyr)
library(ggplot2)
library(RColorBrewer)
library(glue)
library(stringr)
library(readr)

0.3 Setting parameters

Loading necessary paths and parameters

set.seed(123)
source(here::here("misc/paths.R"))
source(here::here("utils/bin.R"))

"{fig_pt}/{plt_dir}" %>%
  glue::glue() %>%
  here::here() %>%
  dir.create(
    path = .,
    showWarnings = FALSE,
    recursive = TRUE)

"{fig_pt}/{robj_dir}" %>%
  glue::glue() %>%
  here::here() %>%
  dir.create(
    path = .,
    showWarnings = FALSE,
    recursive = TRUE)

img_order <- c("uzntl1_fkclxp", "k886qc_rqix54","s2yq8o_t5hk8u", "ivuznh_s8xyfv")

SpatialColors <- colorRampPalette(colors = rev(x = brewer.pal(n = 11, name = "Spectral")))

0.4 Load data

Load Visium data

# 07-sc_mapping_viz.Rmd
# se_obj <- "{map_27}/{robj_dir}/se_deconv_{sample_id}_epid20_pre-rotation.rds"

sp_ls <- lapply(id_sp_df$gem_id, function(id) {

  se_obj <- "{map_27}/{robj_dir}/se_deconv_{id}_epid20.rds" %>%
    glue::glue() %>%
    here::here() %>%
    readRDS(file = .)

  return(se_obj)
})

se_obj <- merge(sp_ls[[1]], y = sp_ls[2:length(sp_ls)],
                add.cell.ids = id_sp_df$gem_id,
                project = "Gloria-Salva")

0.5 Panels

0.5.1 Panel A

In this panel we show the HE images and the mouse percentage per spot.

row1_a <- Seurat::SpatialPlot(
  object = se_obj,
  features = "GRCh38-AGL",
  alpha = c(0, 0),
  images = img_order,
  crop = FALSE,
  image.alpha = 1,
  pt.size.factor = 1.25) &
  Seurat::NoLegend() &
  ggplot2::labs(title = "")

row1_a

row2_a <- Seurat::SpatialPlot(
  object = se_obj,
  features = c("percent.mouse"),
  images = img_order,
  crop = FALSE,
  image.alpha = 0,
  pt.size.factor = 1.25) &
  ggplot2::scale_fill_gradientn(
    colours = SpatialColors(n = 100),
    limits = c(0, 1)) &
  ggplot2::labs(title = "")

row2_a <- ggpubr::ggarrange(row2_a[[1]], row2_a[[2]], row2_a[[3]], row2_a[[4]],
                              ncol = 4, common.legend = TRUE, legend = "right")
row2_a

"{fig_pt}/{plt_dir}/Extended_25-A1.pdf" %>%
  glue::glue() %>%
  here::here() %>%
  cowplot::save_plot(
    filename = .,
    plot = row1_a,
    base_height = 4,
    base_width = 16)

"{fig_pt}/{plt_dir}/Extended_25-A2.pdf" %>%
  glue::glue() %>%
  here::here() %>%
  cowplot::save_plot(
    filename = .,
    plot = row2_a,
    base_height = 4,
    base_width = 16)

0.5.2 Panel B

In this image we show the tumor-associated Schwann cells predicted proportion along with the mouse percentage and the tissue stratification.

Stratify the tissue

se_obj@meta.data <- se_obj@meta.data %>%
  dplyr::mutate(
    stratification = dplyr::case_when(
      sample_id == "GP027_PKLO_Palm_Diet" & Spatial_snn_res.0.5 %in% c(0, 2, 5) ~ "Tumour",
      sample_id == "GP027_PKLO_Palm_Diet" & Spatial_snn_res.0.5 == 3 ~ "Tumour Front",
      sample_id == "GP027_PKLO_Palm_Diet" & Spatial_snn_res.0.5 %in% c(1, 4, 6, 7, 8) ~ "Healthy",
      sample_id == "GP20004_dKDCD36_CT_Diet" & Spatial_snn_res.0.1 == 1 ~ "Tumour",
      sample_id == "GP20004_dKDCD36_CT_Diet" & Spatial_snn_res.0.1 == 2 ~ "Tumour Front",
      sample_id == "GP20004_dKDCD36_CT_Diet" & Spatial_snn_res.0.1 %in% c(0, 3) ~ "Healthy",
      sample_id == "GP029_PLKO_CT_Diet" & Spatial_snn_res.0.3 == 4 ~ "Tumour",
      sample_id == "GP029_PLKO_CT_Diet" & Spatial_snn_res.0.3 == 3 ~ "Tumour Front",
      sample_id == "GP029_PLKO_CT_Diet" & ! Spatial_snn_res.0.3 %in% c(3, 4) ~ "Healthy",
      sample_id == "GP024_dKDCD36_Palm_Diet" & Spatial_snn_res.1 %in% c(3, 7) ~ "Tumour",
      sample_id == "GP024_dKDCD36_Palm_Diet" & Spatial_snn_res.1 %in% c(6, 8) ~ "Tumour Front",
      sample_id == "GP024_dKDCD36_Palm_Diet" & ! Spatial_snn_res.1 %in% c(3, 6, 7, 8) ~ "Healthy"
      ),
    stratification = factor(stratification,
                            levels = c("Healthy", "Tumour Front", "Tumour"))
    )

Plot arrangement

b_ls <- lapply(img_order, function(img) {
  
  # Schwann cells
  tmp1 <- Seurat::SpatialPlot(
    object = se_obj,
    features = c("Tumour-associated Schwann Cells"),
    images = img,
    crop = FALSE,
    image.alpha = 0,
    pt.size.factor = 1.25) &
    ggplot2::scale_fill_gradientn(
      colours = SpatialColors(n = 100),
      limits = c(0, max(se_obj$`Tumour-associated Schwann Cells`)))
  
  # percent.mouse
  tmp2 <- Seurat::SpatialPlot(
    object = se_obj,
    features = c("percent.mouse"),
    images = img,
    crop = FALSE,
    image.alpha = 0,
    pt.size.factor = 1.25) &
    ggplot2::scale_fill_gradientn(
      colours = SpatialColors(n = 100),
      limits = c(0, 1))
  
  # percent.mouse
  tmp3 <- Seurat::SpatialPlot(
    object = se_obj,
    group.by = "stratification",
    images = img,
    crop = FALSE,
    image.alpha = 0,
    pt.size.factor = 1.25) +
    ggplot2::scale_fill_manual(
      values = c("#009E73", "#E69F00", "#D55E00"),
      breaks = c("Healthy", "Tumour Front", "Tumour")) +
    ggplot2::theme(legend.position = "top") +
    ggplot2::guides(
      fill = ggplot2::guide_legend(override.aes = list(size = 5)))
  
  cowplot::plot_grid(
    plotlist = list(tmp1, tmp2, tmp3),
    align = "hv",
    axis = "trbl",
    nrow = 1)

})

Join the sub-panels of panel B

panel_b <- plot_grid(plotlist = b_ls, ncol = 2, align = "hv", axis = "trbl")
panel_b

"{fig_pt}/{plt_dir}/Extended_25-B.pdf" %>%
  glue::glue() %>%
  here::here() %>%
  cowplot::save_plot(
    filename = .,
    plot = panel_b,
    base_height = 12,
    base_width = 30)

0.5.3 Panel C

In this panel we show the violin plots of the predicted proportions of tumour-associated Schwann cells stratified by healthy, tumour front and tumour.

my_comparisons <- list(
    c("Tumour", "Tumour Front"),
    c("Tumour", "Healthy"),
    c("Tumour Front", "Healthy")
    )

panel_c <- se_obj@meta.data %>%
  dplyr::mutate(
    sample_id = factor(sample_id,
                       levels = c( "GP027_PKLO_Palm_Diet", "GP029_PLKO_CT_Diet",
                                   "GP024_dKDCD36_Palm_Diet", "GP20004_dKDCD36_CT_Diet"))
  ) %>%
  ggplot2::ggplot(.,
  ggplot2::aes(x = stratification, y = `Tumour-associated Schwann Cells`)) +
  ggplot2::geom_violin(
    alpha = 0.7,
    ggplot2::aes(fill = stratification, color = stratification)) +
  ggplot2::geom_jitter(ggplot2::aes(color = stratification)) +
  ggplot2::facet_wrap(.~sample_id, scales = "free") +
  ggplot2::labs(
    x = "Tissue Stratification",
    y = "Proportion of Tumour-associated Schwann Cells") +
  ggplot2::theme_classic() +
  ggpubr::stat_compare_means(
    label = "p.format",
    comparisons = my_comparisons,
    p.adjust.method = "bonferroni",
    ) +
  # ggpubr::stat_compare_means(label.y = c(0.75, 0.5, 0.85, 0.75)) + # Add global p-value
  ggplot2::scale_fill_manual(values = c("#009E73", "#E69F00", "#D55E00")) +
  ggplot2::scale_color_manual(values = c("#009E73", "#E69F00", "#D55E00")) +
  ggplot2::theme(legend.title = element_blank())

panel_c

"{fig_pt}/{plt_dir}/Extended_25-C.pdf" %>%
  glue::glue() %>%
  here::here() %>%
  cowplot::save_plot(
    filename = .,
    plot = panel_c,
    base_height = 9,
    base_width = 12)

0.6 Session Info

sessionInfo()
## R version 4.0.4 (2021-02-15)
## Platform: x86_64-pc-linux-gnu (64-bit)
## Running under: Ubuntu 20.04.2 LTS
## 
## Matrix products: default
## BLAS:   /usr/local/lib/R/lib/libRblas.so
## LAPACK: /usr/local/lib/R/lib/libRlapack.so
## 
## locale:
##  [1] LC_CTYPE=en_US.UTF-8          LC_NUMERIC=es_ES.UTF-8        LC_TIME=es_ES.UTF-8           LC_COLLATE=en_US.UTF-8        LC_MONETARY=es_ES.UTF-8       LC_MESSAGES=en_US.UTF-8       LC_PAPER=es_ES.UTF-8          LC_NAME=es_ES.UTF-8           LC_ADDRESS=es_ES.UTF-8        LC_TELEPHONE=es_ES.UTF-8      LC_MEASUREMENT=es_ES.UTF-8    LC_IDENTIFICATION=es_ES.UTF-8
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
##  [1] readr_1.4.0        stringr_1.4.0      glue_1.4.2         RColorBrewer_1.1-2 dplyr_1.0.6        cowplot_1.1.1      ggpubr_0.4.0       ggplot2_3.3.3      SeuratObject_4.0.1 Seurat_4.0.2       BiocStyle_2.18.1  
## 
## loaded via a namespace (and not attached):
##   [1] readxl_1.3.1          backports_1.2.1       plyr_1.8.6            igraph_1.2.6          lazyeval_0.2.2        splines_4.0.4         listenv_0.8.0         scattermore_0.7       digest_0.6.27         htmltools_0.5.1.1     magick_2.7.2          fansi_0.4.2           magrittr_2.0.1        tensor_1.5            cluster_2.1.0         ROCR_1.0-11           openxlsx_4.2.3        globals_0.14.0        matrixStats_0.58.0    spatstat.sparse_2.0-0 colorspace_2.0-1      ggrepel_0.9.1         haven_2.4.1           xfun_0.23             crayon_1.4.1          jsonlite_1.7.2        spatstat.data_2.1-0   survival_3.2-7        zoo_1.8-9             polyclip_1.10-0       gtable_0.3.0          leiden_0.3.8          car_3.0-10            future.apply_1.7.0    abind_1.4-5           scales_1.1.1          DBI_1.1.1             rstatix_0.7.0         miniUI_0.1.1.1        Rcpp_1.0.6            viridisLite_0.4.0     xtable_1.8-4          reticulate_1.20       spatstat.core_2.1-2   foreign_0.8-81        htmlwidgets_1.5.3     httr_1.4.2            ellipsis_0.3.2        ica_1.0-2             farver_2.1.0          pkgconfig_2.0.3       sass_0.4.0            uwot_0.1.10           deldir_0.2-10        
##  [55] utf8_1.2.1            here_1.0.1            labeling_0.4.2        tidyselect_1.1.1      rlang_0.4.11          reshape2_1.4.4        later_1.2.0           munsell_0.5.0         cellranger_1.1.0      tools_4.0.4           cli_2.5.0             generics_0.1.0        broom_0.7.6           ggridges_0.5.3        evaluate_0.14         fastmap_1.1.0         yaml_2.2.1            goftest_1.2-2         knitr_1.33            fitdistrplus_1.1-3    zip_2.1.1             purrr_0.3.4           RANN_2.6.1            pbapply_1.4-3         future_1.21.0         nlme_3.1-152          mime_0.10             compiler_4.0.4        rstudioapi_0.13       plotly_4.9.3          curl_4.3.1            png_0.1-7             ggsignif_0.6.1        spatstat.utils_2.1-0  tibble_3.1.2          bslib_0.2.5.1         stringi_1.6.2         highr_0.9             forcats_0.5.1         lattice_0.20-41       Matrix_1.3-3          vctrs_0.3.8           pillar_1.6.1          lifecycle_1.0.0       BiocManager_1.30.15   spatstat.geom_2.1-0   lmtest_0.9-38         jquerylib_0.1.4       RcppAnnoy_0.0.18      data.table_1.14.0     irlba_2.3.3           httpuv_1.6.1          patchwork_1.1.1       R6_2.5.0             
## [109] bookdown_0.22         promises_1.2.0.1      KernSmooth_2.23-18    gridExtra_2.3         rio_0.5.26            parallelly_1.25.0     codetools_0.2-18      MASS_7.3-53           assertthat_0.2.1      rprojroot_2.0.2       withr_2.4.2           sctransform_0.3.2     mgcv_1.8-33           parallel_4.0.4        hms_1.1.0             grid_4.0.4            rpart_4.1-15          tidyr_1.1.3           rmarkdown_2.8         carData_3.0-4         Rtsne_0.15            shiny_1.6.0